home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 2614.ZIP / 50ERRS.ZIP / S87ERMAP.PRG < prev    next >
Text File  |  1990-10-05  |  13KB  |  359 lines
  1. /**************************************************************************
  2. *
  3. * Module name:
  4. *
  5. *    S87ErMap.prg
  6. *
  7. * What it does:
  8. *
  9. *    Clipper 5.0 routine to re-package 5.0 Error Handling conventions
  10. *    to those compatible with Summer '87.  This allows you to compile
  11. *    and link your Summer '87 applications with Clipper 5.0 and
  12. *    retain your existing Summer '87 modifications to the six UDF()s
  13. *    in ErrorSys.prg.  You may select either Summer '87 or
  14. *    Clipper 5.0 Error Handling for your program at run-time via a
  15. *    DOS 'SET ERRORSYS=' command.
  16. *
  17. *    This routine demonstrates the power and flexibility of Clipper 5.0
  18. *    nested arrays, ErrorBlock() posting, code blocks, the EVAL()
  19. *    function, table look-up with ASCAN(), the use of optional code
  20. *    blocks with array iterator functions and how code blocks and
  21. *    UDF()s can be chained as RETURN arguments.  The actual mapping 
  22. *    part of this routine is only four (4) lines.  It could have
  23. *    been written in two (2) lines!
  24. *
  25. * How to compile it:
  26. *
  27. *    Clipper S87ErMap /n/w/a
  28. *
  29. * How to link it:
  30. *
  31. *    Link in S87ErMap.obj with your application
  32. *
  33. * How to use it:
  34. *
  35. *    Insert the following line at the start of your program to call
  36. *    the UDF() in this routine that will post a new ErrorBlock():
  37. *    
  38. *    S87ErrorSys()
  39. *
  40. * To request Summer '87 Error Handling at run-time:
  41. *
  42. *    SET ERRORSYS=S87
  43. *
  44. * To request Clipper 5.0 Error Handling at run-time:
  45. *
  46. *    SET ERRORSYS=5.0    (default)
  47. *
  48. * Written by:
  49. *
  50. *    Philip H. Schwartz
  51. *    Vertical Management Systems, Inc.
  52. *    POB 90243
  53. *    Gainesville, FL  32607
  54. *    Compuserve: 72537,3261
  55. *
  56. * Written on:
  57. *
  58. *    June 3, 1990     (for Palm Desert DevCon)
  59. *
  60. * Last updated on:
  61. *
  62. *    October 5, 1990  (for Orlando Devcon)
  63. *
  64. * Rights:
  65. *
  66. *    (c) 1990 Philip H. Schwartz
  67. *
  68. * Release:
  69. *
  70. *    Written for tutorial purposes and non-commercial distribution
  71. *    rights assigned to Clipper developer community.  May be distributed
  72. *    in this form without charge.  Commercial and publishing rights
  73. *    reserved.
  74. *
  75. * Warranty:
  76. *
  77. *    None.
  78. *
  79. * Comments:
  80. *
  81. *    Additional material (text and code) will be available
  82. *    in a forthcoming monograph on the Clipper 5.0 Error System
  83. *    and in a series of Nantucket News articles.
  84. *
  85. **************************************************************************/
  86.  
  87. #include "error.ch"            // 5.0 EG_xxxx generic code definitions
  88.  
  89. #define GENCODE       1      // Column in mapping array of gencode() error
  90. #define CODEBLOCK      2     // Column in mapping array of code block id
  91.  
  92. #define CALL_LEVEL    3     /* This is how far to go back in the
  93.                    ProcName() and ProcLine() stack
  94.                    to find the procedure that generated
  95.                    the error.  We must pass the procedure
  96.                    name and procedure line to the S'87
  97.                    UDF()s.
  98.   
  99.                    Level 1 - The error handler we are now in.
  100.                    Level 2 - The code block statement that
  101.                              set up the call to the error
  102.                          handler function: '(b)procname'.
  103.                    Level 3 - The application code or
  104.                             Nantucket routine in which the
  105.                          error occurred.  This is where
  106.                          we    really want to be, so we
  107.                          set the CALL_LEVEL constant to
  108.                          3.
  109.                                          */      
  110.  
  111. ***
  112. *    These preprocessor constants are used to map a Clipper 5.0 error
  113. *    condition (as defined by include file "error.ch") to the S'87 UDF
  114. *    that would normally be responsible.
  115. *
  116. *    The following definitions identify the code blocks that will
  117. *    call the S'87 error functions with the proper parameters.
  118. ***
  119. #define EXPR_ERROR    1    // 1 - Expression Error
  120. #define UNDEF_ERROR    2    // 2 - Undefined Error
  121. #define OPEN_ERROR    3     // 3 - Open Error
  122. #define DB_ERROR    4      // 4 - Database Error
  123. #define PRINT_ERROR    5    // 5 - Print Error
  124. #define MISC_ERROR    6        // 6 - Miscellaneous Error
  125.  
  126. #define UNKNOWN_ERROR    7    // 7 - Unknown Clipper 5.0 e:gencode()
  127.                 /* This is not one of the S'87 UDF()s.
  128.                    We will stuff the unknown gencode in
  129.                    the description text that we pass to
  130.                    MISC_ERROR.                */
  131.  
  132.  
  133. STATIC bDefaultHandler        /* This is where we save the default
  134.                    Clipper 5.0 Error Code Block.  We mark
  135.                    it STATIC so it can be visible throughout
  136.                    the module (prg).              */ 
  137.  
  138. ***
  139. *    FUNCTION S87ErrorSys()
  140. *
  141. *    The only purpose of S87ErrorSys() is to provide a simple calling
  142. *    interface to the mapping function.  Rather than ask the main
  143. *    application program to install a new ErrorBlock() and keep track
  144. *    of the default 5.0 handler, it is simpler to insert a one line
  145. *    function call in the main program.
  146. *
  147. *    This function will install the new ErrorBlock() and save the
  148. *    default Clipper 5.0 Error Handler.  The function is purposely not
  149. *    marked STATIC so that it can be visible to the main program.
  150. ***
  151. FUNCTION S87ErrorSys
  152. bDefaultHandler := ErrorBlock( {|e| S87to50( e ) } )
  153. RETURN NIL
  154.               
  155.  
  156. ***
  157. *    FUNCTION S87to50()
  158. *
  159. *      This is the function that maps the Clipper 5.0 Error
  160. *    Object to the calling sequences used in S'87.
  161. *
  162. *    Note:
  163. *    (1) the function is marked STATIC to prevent outside calls.
  164. *    (2) the Error Object (e) is passed as a formal parameter.
  165. ***
  166. STATIC FUNCTION S87to50( e )
  167.  
  168. LOCAL aS87UdfTable             // array of code blocks to call S'87 UDF()s
  169. LOCAL aS87MapTable           // array to map gencode to S'87 UDF()s
  170. LOCAL nS87udf            // id of code block to handle current error
  171.  
  172. ***
  173. *    The following code checks to see if 5.0 or S'87 Error Handling
  174. *    conventions are to be followed.  If 5.0 is selected, the
  175. *    default Clipper 5.0 Error Handler is EVAL()uated, passing along
  176. *    the current Error Object (e).  Otherwise, we continue with the
  177. *    S'87 re-mapping.
  178. ***
  179. IF "5.0" $ GETE( "ERRORSYS" ) .OR. !( "S87" $ UPPER( GETE( "ERRORSYS" ) ) )
  180.   RETURN( EVAL( bDefaultHandler, e ) )
  181. ENDIF
  182.  
  183. /***
  184. *    Background information on how Summer '87 performed
  185. *    Error Handling.
  186. ***
  187.      These are the six UDF()s in S'87 that are located in the
  188.     ErrorSys.prg module.  Each one handles a particular set of
  189.     error situations.
  190.  
  191.     Expr_Error( Name, Line, Info, Model, _1, _2, _3 )
  192.    
  193.     Undef_Error( Name, Line, Info, Model, _1 )
  194.       
  195.     Open_Error( Name, Line, Info, Model, _1 )
  196.         
  197.     DB_Error( Name, Line, Info )
  198.       
  199.     Print_Error( Name, Line )
  200.       
  201.     Misc_Error( Name, Line, Info, Model )
  202.     
  203.  
  204.     These parameters have the following meaning:
  205.     
  206.     Name        procedure/udf/clipper library routine
  207.       
  208.     Line        source line   (0 for most library routines)
  209.     
  210.     Info        error description text
  211.     
  212.     Model        model of expression in which error occurred,
  213.             e.g. if error occurred during ADD of 
  214.             two numbers, the model would be "_1+_2".  The
  215.             model parameter was never consistently
  216.             implemented in S'87 and is of limited use.  In
  217.             most cases, we will map the 5.0 e:operation()
  218.             instance variable to the S'87 model parameter.
  219.     
  220.     _1,_2,_3    arguments that are symbols in model statement,
  221.             e.g. if error occurred during 6+"4",
  222.             _1 would equal numeric 6 and _2 would equal
  223.             character string "4".  In Summer '87 it was
  224.             necessary to check PCOUNT() on entry to UDF to
  225.             check total number of arguments passed.
  226.             Parameters that are missing in 5.0 will be
  227.             replaced with a null string ("") before calling
  228.             the S'87 error functions.
  229. ***/
  230.  
  231. ***
  232. *    This is an array of code blocks that set up the arguments
  233. *    for the Summer '87 error handling functions.  The argument list
  234. *    to the code block is NULL in each case since the Error Object
  235. *    instance variables will be passed to the S'87 routines already
  236. *    resolved.  
  237. *
  238. *    Note:  The Clipper 5.0 documentation incorrectly refers to
  239. *    instance variable 'ARGS'.  This array of optional arguments
  240. *    was changed to PARAMS between the BETA testing of 5.0 and its
  241. *    production release.
  242. *
  243. ***
  244. aS87UdfTable := ;
  245. { { || Expr_Error( ProcName( CALL_LEVEL ), ProcLine( CALL_LEVEL ), ;
  246.        e:description(), e:operation(), ParamsCheck( e:params(), 1 ), ;
  247.        ParamsCheck( e:params(), 2 ), ParamsCheck( e:params(), 3 ) ) }, ;
  248.   { || Undef_Error( ProcName( CALL_LEVEL ), ProcLine( CALL_LEVEL ), ;
  249.        e:description, "", e:operation() ) }, ;
  250.   { || Open_Error( ProcName( CALL_LEVEL ), ProcLine( CALL_LEVEL ), ;
  251.        e:description(), e:operation(), e:filename() ) }, ;
  252.   { || DB_Error( ProcName( CALL_LEVEL ), ProcLine( CALL_LEVEL ), ;
  253.        e:description() ) }, ;
  254.   { || Print_Error( ProcName( CALL_LEVEL ), ProcLine( CALL_LEVEL ) ) }, ;
  255.   { || Misc_Error( ProcName( CALL_LEVEL ), ProcLine( CALL_LEVEL ), ;
  256.        e:description(), e:operation() ) }, ;
  257.   { || Misc_Error( ProcName( CALL_LEVEL ), ProcLine( CALL_LEVEL ), ;
  258.        e:description() + " - gencode[" + LTRIM( STR( e:gencode() ) ) + "]", ;
  259.        e:operation() ) } }
  260.  
  261. ***
  262. *    This is our Summer '87 Error Mapping Table.  This is a
  263. *    nested array that is set up as a 29 x 2 table.  The first
  264. *    column contains one of the Generic error codes found in
  265. *    "error.ch".  The second column identifies which code block in
  266. *    the code block table is responsible for calling the associated
  267. *    S'87 error function.
  268. *
  269. *    As the "error.ch" include file grows in new 5.0 releases,
  270. *    just make a corresponding entry in the mapping table below.
  271. *
  272. *--------------------------------------------------------------------
  273. *                   5.0 Gencode         S'87 UDF() Identifier
  274. *--------------------------------------------------------------------
  275. aS87MapTable := { { EG_ARG,             EXPR_ERROR }, ;
  276.                   { EG_BOUND,           EXPR_ERROR }, ;
  277.                   { EG_STROVERFLOW,     EXPR_ERROR }, ;
  278.                   { EG_NUMOVERFLOW,     EXPR_ERROR }, ;
  279.                   { EG_ZERODIV,         EXPR_ERROR }, ;
  280.                   { EG_NUMERR,          EXPR_ERROR }, ;
  281.           { EG_SYNTAX,          UNDEF_ERROR } ,;
  282.                   { EG_COMPLEXITY,      UNDEF_ERROR }, ;
  283.                   { EG_MEM,             UNDEF_ERROR }, ;
  284.                   { EG_NOFUNC,          UNDEF_ERROR }, ;
  285.                   { EG_NOMETHOD,        UNDEF_ERROR }, ;
  286.                   { EG_NOVAR,           UNDEF_ERROR }, ;
  287.           { EG_OPEN,            OPEN_ERROR }, ;
  288.           { EG_NOALIAS,         DB_ERROR }, ;
  289.                   { EG_CREATE,          DB_ERROR }, ;
  290.                   { EG_CLOSE,           DB_ERROR }, ;
  291.                   { EG_READ,            DB_ERROR }, ;
  292.                   { EG_WRITE,           DB_ERROR }, ;
  293.                   { EG_SHARED,          DB_ERROR }, ;
  294.                   { EG_UNLOCKED,        DB_ERROR }, ;
  295.                   { EG_READONLY,        DB_ERROR }, ;
  296.                   { EG_PRINT,           PRINT_ERROR }, ;
  297.            { EG_UNSUPPORTED,     MISC_ERROR }, ;
  298.                   { EG_LIMIT,           MISC_ERROR }, ;
  299.                   { EG_CORRUPTION,      MISC_ERROR }, ;
  300.                   { EG_DATATYPE,        MISC_ERROR }, ;
  301.                   { EG_DATAWIDTH,       MISC_ERROR }, ;
  302.                   { EG_NOTABLE,         MISC_ERROR }, ;
  303.           { EG_NOORDER,         MISC_ERROR } }
  304.  
  305. ***
  306. *    We use ASCAN() to locate the correct gencode entry in the
  307. *    mapping table.  The code block tells ASCAN() that we are
  308. *    looking for the row in the mapping table that contains an entry
  309. *    for the gencode    associated with the current Error Object.
  310. *    Since the array    is nested, we use the GENCODE constant to identify
  311. *    the column that contains the gencode (column 1).
  312. ***
  313. nS87udf :=  ASCAN( aS87MapTable, {|arr| arr[GENCODE] == e:gencode()} )
  314.  
  315.  
  316. ***
  317. *    Now we know the id of the code block that will set up the
  318. *    parameters for a call to the appropriate S'87 UDF().  We use
  319. *    the id to index into the code block table and EVAL()uate the
  320. *    code block.  Since S'87 error functions know nothing about
  321. *    the Clipper 5.0 Error Object, and the argument portion of the
  322. *    code block (||) is null, it is not necessary to pass the
  323. *    Error Object in the EVAL().
  324. *
  325. *    Here's what happens:
  326. *
  327. *    The S'87 error UDF() will either quit, break or return a
  328. *    logical value (T/F).  The EVAL() function will pass this logical
  329. *    value back to the Clipper 5.0 low-level error routines via the
  330. *    RETURN().
  331. *
  332. *    If the gencode() was not found in the mapping table, we will call
  333. *    the S'87 Misc_Error() function with the unknown gencode() added
  334. *    to the the Nantucket-supplied error description.  
  335. ***
  336. RETURN( ;
  337.   EVAL( ;
  338.     aS87UdfTable[ ;
  339.       aS87MapTable[ if( nS87udf == 0, UNKNOWN_ERROR, nS87udf ), CODEBLOCK ] ;
  340.     ] ;
  341.   ) ;
  342. ) 
  343.  
  344. /***
  345. *    This function tests for the presence of an optional e:params()
  346. *    instance variable.
  347. *
  348. *    Note:
  349. *    (1) e:params() must be an Array
  350. *    (2) a null string is returned if the element does not exist    
  351. */
  352. STATIC FUNCTION ParamsCheck( aArgs, nPosition )
  353. IF VALTYPE( aArgs ) == "A"
  354.   RETURN( IF( nPosition <= LEN( aArgs ), aArgs[ nPosition ], "" ) )
  355. ENDIF
  356. RETURN( "" )
  357. /*eof*/
  358.  
  359.